Draft produced by Dr. Michele Claibourn and Michael Salgueiro for Accountability Metrics Committee meeting on February 2nd, 2022

Below we provide an initial view of potential visualizations for accountability metrics, focusing on potential outcomes identified by the Pipelines and Pathways working group: (1) the degree to which families in the Charlottesville region are struggling with less than family-sustaining wages and (2) UVA’s contribution to providing jobs with family-sustaining wages to the community.1

library(tidyverse)
library(ggthemes)
# library(patchwork)
library(plotly)

fsw <- readRDS("family_income_all.RDS")
fsw_race <- readRDS("family_income_race.rDS")

Community Outcome: Family Sustaining Wages

Many families struggle to afford the essentials – food, clothing, shelter, and utilities – plus the expenses necessary to hold a job – transportation and childcare. The figures below show the number and percent of families in the Charlottesville region whose annual income is below $35,000.2

Overall

loc_num <- fsw %>% 
  filter(income != "$35,000 or more") %>% 
  ggplot(aes(x = year, y = families, fill = income, label = percent)) +
  geom_area() +
  scale_x_continuous(name = "", breaks = seq(2009, 2019, 1)) +
  scale_fill_brewer(name = "Income Range", palette = "BuPu") +
  labs(y = "# of Families Struggling") +
  theme_minimal() 

loc_per <- fsw %>% 
  filter(income != "$35,000 or more") %>% 
  group_by(year) %>% 
  summarize(families = sum(families),
            total = first(total)) %>% 
  mutate(percent_families = round(families/total*100, 1)) %>% 
  ggplot(aes(x = year, y = percent_families, label = families)) +
  geom_line() +
  annotate("text", x = 2019, y = 17.4, label = "15.4%", color = "#88419d") +
  coord_cartesian(xlim = c(2009, 2019), 
                  clip = 'off') +   
  scale_y_continuous(name = "% of Families Struggling", limits = c(0,30)) +
  scale_x_continuous(name = "", breaks = seq(2009, 2019, 1)) +
  theme_clean()

subplot(loc_num, loc_per, nrows = 2, shareX = T, 
        titleX = T, titleY = T, which_layout = 1) %>% 
  layout(
    yaxis = list(
      dtick = 2000, 
      tick0 = 0, 
      tickmode = "linear"
    ))

By Race and Ethnicity

loc_race_num <- fsw_race %>% 
  filter(income != "$35,000 or more") %>% 
  group_by(year, race) %>% 
  summarize(families = sum(families),
            total = first(total)) %>% 
  mutate(percent_families = round(families/total*100, 1)) %>% 
  ggplot(aes(x = year, y = families, fill = race, label = percent_families)) +
  geom_area() +
  scale_x_continuous(name = "", breaks = seq(2009, 2019, 1)) +
  scale_fill_brewer(name = "Family Race", palette = "Set1") +
  labs(y = "# of Families Struggling") +
  theme_minimal() 

loc_race_per <- fsw_race %>% 
  filter(income != "$35,000 or more") %>% 
  group_by(year, race) %>% 
  summarize(families = sum(families),
            total = first(total)) %>% 
  mutate(percent_families = round(families/total*100, 1)) %>% 
  ggplot(aes(x = year, y = percent_families, color = race, label = families)) +
  geom_line() +
  scale_color_brewer(name = "Family Race", palette = "Set1") +
  scale_y_continuous(name = "% of Families Struggling", breaks = seq(10,60,10)) +
  scale_x_continuous(name = "", breaks = seq(2009, 2019, 1)) +
  theme_bw()

subplot(loc_race_num, loc_race_per, nrows = 2, shareX = T, 
        titleX = T, titleY = T, which_layout = 1) %>% 
  layout(
    yaxis = list(
      dtick = 2000, 
      tick0 = 0, 
      tickmode = "linear"
    )) %>% 
  style(showlegend = FALSE, traces = 6:12)

Regional Expenses

Here we could show the estimated expenses over time (the necessary information is accessible but not yet collated).
























University Outcomes

We don’t currently have access to relevant data but suggestions based on conversations have included:

Entry-Level Employee Composition

Proposed metrics to understand multiple year trends in entry-level workforce composition include:

  • Number/percent of staff in $30K-$40K and $40K-$50K pay bands, disaggregated by defined disadvantaged groups3 (should data exist)
  • Number/percent of staff hired in prior 12 months into positions in $30K-$40K and $40K-$50K pay bands, disaggregated by defined disadvantaged groups where possible (should data exist)

Additionally, there may be interest in understanding the scale, if not the composition, of contract workers at the University. A possible metric may be:

  • Number of contract workers at the University, disaggregated by pay band

These figures might be updated annually or at some other meaningful period of time.

Removing Barries and Retention

Possibilites that have risen in conversation include

  • Snapshot of number/percent of entry-level position descriptions that include unnecessary position requirements4
  • Number/percent of individuals in positions within $30K-$40K pay band and/or within specific position clusters (e.g., health system) who exit annually, disaggregated by defined disadvantaged groups (over a given period of years)







University Interventions: Working Group Recommendations

Here we imagine a table providing information on new and ongoing initiatives, policy changes, partner progams, or other interventions intended to create pipelines for targeted local residents into UVA employment and to forge pathways for job advancement.

library(reactable)
library(htmltools)
library(googlesheets4)

# functions ----
# Function needed according to Greg Lin, creator of reactable
html <- function(x, inline = FALSE) {
  container <- if (inline) htmltools::span else htmltools::div
  container(dangerouslySetInnerHTML = list("__html" = x))
}

# Render a bar chart with a label on the left
# from tutorial: https://glin.github.io/reactable/articles/building-twitter-followers.html
bar_chart <- function(label, width = "100%", height = "14px", fill = "#00bfc4", background = NULL) {
  bar <- div(style = list(background = fill, width = width, height = height))
  chart <- div(style = list(flexGrow = 1, marginLeft = "6px", background = background), bar)
  div(style = list(display = "flex", alignItems = "center"), label, chart)
}

# read data
status <- read_sheet("https://docs.google.com/spreadsheets/d/1Jz-Z3UGs8o5HE9YmckMyUPyp33pA9HXmgrI-mLcnR9Q/edit#gid=294144601", 
                     sheet = "table")

# split subitems
status <- status %>% 
  mutate(Activities = str_split(status$Activities, ";"))

# make table
reactable(status, 
          columns = list(
            Activities = colDef(show = FALSE),
            `Creating New Pipelines` = colDef(minWidth = 300),
            
            `2022 Stage` = colDef(align = "center",
                                  style = function(value) {
                                    if (value == "E") {
                                      color <- "#fee6ce"
                                    } else if (value == "I") {
                                      color <- "#fdae6b"
                                    } else {
                                      color <- "#e6550d"
                                    }
                                    list(background = color, fontWeight = "bold")
                                  }),
            
            `Time Period` = colDef(
              # Render the bar charts using a custom cell render function
              cell = function(value) {
                if (value == "Short") {
                  width = 25
                } else if (value == "Mid") {
                  width = 50
                } else if (value == "Long") {
                  width = 75
                } else {
                  width = 100
                }
                bar_chart(value, width = width, fill = "#08519c")
              },
              # And left-align the columns
              align = "left"
          ),
          
          `Accountable Organization` = colDef(align = "center")
          ),
          
          # if there additional activities, make row expandable
          details = function(index) {
            if(!is.na(status$Activities[index])) {
              ul <- tags$ul()
              list <- unlist(status$Activities[index])
              ul$children <- lapply(seq_len(length(list)), function(index) {
                tags$li(list[index])
              })
              ul
            } 
          }
)
Table Legend


legend <- read_sheet("https://docs.google.com/spreadsheets/d/1Jz-Z3UGs8o5HE9YmckMyUPyp33pA9HXmgrI-mLcnR9Q/edit#gid=294144601", 
                     sheet = "legend")

legend <- legend %>% 
  mutate(`Current Stage (Q1 2022)` = ifelse(is.na(`Current Stage (Q1 2022)`), "", `Current Stage (Q1 2022)`))

reactable(legend,
          width = 500,
          columns = list(
            `Current Stage (Q1 2022)` = colDef(align = "center",
                                  style = function(value) {
                                    if (value == "Explore (E)") {
                                      color <- "#fee6ce"
                                    } else if (value == "Implement (I)") {
                                      color <- "#fdae6b"
                                    } else if (value == "Complete (C)") {
                                      color <- "#e6550d"
                                    } else {
                                      color <- "white"
                                    }
                                    list(background = color, fontWeight = "bold")
                                  }),
            
            `Anticipated Time (as of Q1 2022)` = colDef(
              # Render the bar charts using a custom cell render function
              cell = function(value) {
                if (value == "Year 1 (Short)") {
                  width = 25
                } else if (value == "Years 2-3 (Mid)") {
                  width = 50
                } else if (value == "Years 4+ (Long)") {
                  width = 75
                } else {
                  width = 100
                }
                bar_chart(value, width = width, fill = "#08519c")
              },
              # And left-align the columns
              align = "left"
            )
            
          )
          )

End notes


  1. Following the work of the Orange Dot report, in this initial draft we define the Charlottesville region as the city of Charlottesville, Albemarle County, Buckingham County, Fluvanna County, Greene County, Louisa County, and Nelson County. This can be altered in accord with the consensus of the working groups.↩︎

  2. Estimates of the number and percent of families with incomes below $35,000 are based on American Community Survey 5-year estimates (Table B19101). The 2005-2009 estimates are used for the 2009 measure, 2006-2010 estimates are used for the 2010 measure, and so on. The U.S Census Bureau discourages making over time comparisons based on data with overlapping estimates (see here for more) to infer change, as the estimates are based much of the same data. We would refrain from making inferential statements about trends from year to year, but can use them to understand longer-term (e.g., 10-year) changes. Alternatively, we could choose to use the ACS 1-year estimates as provided in Table B19101 for the Charlottesville Metropolitian Statistical Area which includes the city of Charlottesville, Albemarle County, Fluvanna County, Greene County, and Nelson County but not Louisa County which is part of the regional planning district (or Buckingham County, which is not part of the regional planning district). An additional possibility is to use the Public Use Microdata Samples provided by the Census for the two Public Use Microdata Areas comprising the Thomas Jefferson planning district to derive the estimates. This route could also allow us to estimate familiy-sustaining wages for population categories in addition to race and ethnicity, but will also be more labor-intensive.↩︎

  3. Defined disadvantaged groups, as per ‘Pipelines & Pathways Working Group: Report and Recommendations’ (2022): a) Black, Latino/a and Asian; b) Criminal-justice involved; c) People with disabilities; d) Women; e) English language learners; f) Adults with no High School diploma or equivalent; g) Low income; h) Technology challenged; i) Parents without access to affordable childcare.↩︎

  4. To be defined by Working Group. One area for reform is around misaligned educational requirements, as per the recommendations in ‘Pipelines & Pathways Working Group: Report and Recommendations’ (2022).↩︎